﻿namespace Cephei

    ///     Module for generating source code from model definitions    
    module Generator = 

        open System
        open System.Text 
        open Cephei.Core
        open Cephei.Core.Generic 
        open System.Collections
        open System.Collections.Generic 
        open System.Reflection

        type IndexEntry = {tier : int; cell : ICell}

        let StripMnmonic (m : string) =
            String (m.ToCharArray() |> Array.filter (fun c -> Char.IsLetterOrDigit(c) || c = '!'))

        let CleanMnmonic (m : String) = 
            let s = StripMnmonic  m
            match s.Substring (0, 2) with
            | a when a = "!+"   -> s.Substring(2).Replace ('!', '.')
            | b when b = "!-"   -> s.Substring(2).Replace ('!', '.')
            | b when b = "!!"   -> s.Substring(2).Replace ('!', '.')
            | _                 -> s.Substring(1).Replace ('!', '.')

        let BareMnmonic (m : string) = m.Replace("!","")

        let LetMnmonic (m : string) = "_" + (CleanMnmonic m)

        let LocalMnemonic (m : string) = 
            m.Substring(m.LastIndexOf ('!') + 1)

        let HashValue (p : (Type *string array)) : int =
            let f (a,b) = a
            let s (a,b) = b
            let hs (s:string) : int = s.GetHashCode()
            let h = (f p).GetHashCode ()
            Array.fold (fun (a : int) (s : string) -> a + (hs s)) h (s p)
(*
        let LocalMnmonic (c : ICell, m : IModel) = 
            let rec findM (c : ICell) : bool = 
                if c.Parent = m then true
                elif c.Parent = null then false
                else findM c.Parent
            if findM c then 
                CleanMnmonic (c.Mnmonic.Replace (c.Parent.Mnmonic, ""))
            else 
                CleanMnmonic (c.Mnmonic)
*)
        let cellType (c : ICell) = 
            let rec ctype (t : Type) = 
                if t.IsGenericType then
                    t.GetGenericArguments().[0]
                else
                    if t = typeof<Object> then 
                        null
                    else
                        ctype t.BaseType 
            ctype (c.GetType())

        /// render the type as source
        let rec sourceType (t : Type) =
            if not t.IsGenericType then
                t.FullName 
            else
                let fullname = t.FullName.Substring (0, t.FullName.IndexOf ('`'))
                let pams = 
                    Array.fold (fun e y -> e + "," + (sourceType y)) "" (t.GetGenericArguments())
                fullname + "<" + pams.Substring(1) + ">"

        let ValueAsText (o : Object) =
            let doubleSrc (d : double) =
                let s = d.ToString();
                if s.IndexOf ('.') = -1 && s.IndexOf('e') = -1 && s.IndexOf('E') = -1 then
                    s + ".0"
                else 
                    s
            match o with
            | :? string as s                -> sprintf "\"%s\"" s
            | :? DateTime as d              -> sprintf "(new DateTime(%d, %d, %d))" d.Year d.Month d.Day
            | :? Double as d                -> doubleSrc d
            | null                          -> "null"
            | x                             -> sprintf "%s" (x.ToString())
        
        let SeqEnum (e : IEnumerable) : obj seq =
            seq {
                let e = e.GetEnumerator() 
                while (e.MoveNext()) do
                    yield e.Current
                }
        // Get the source for an enumeration value
        let rec EnumerableValue (e : IEnumerable) (incValue : bool) (t : Type) =
            let castO2 (o : obj) (t2 : Type) = 
                if t2 = t then
                    o.ToString()
                elif o :? ICell then
                    let c = o :?> ICell
                    if c.Mnmonic = null then
                        sprintf "((cell.Value %s) :> %s)" (ValueSource c false t incValue) (sourceType t)
                    else
                        sprintf "(%s :> %s)" (ValueSource c false t incValue) (sourceType t)
                else
                    sprintf "(%s :> %s)" (o.ToString()) (sourceType t)

            let castO (o : obj) = castO2 o (o.GetType())
            let asDate (d : DateTime) : string = sprintf "DateTime(%d, %d, %d)" d.Year d.Month d.Day
            let isd (d : IEnumerable<DateTime>) : string =  Seq.fold (fun a i -> a + ";" + asDate i) "" d
            let iss (s : IEnumerable<string>) : string =  Seq.fold (fun a i -> a + ";\"" + i.ToString() + "\"") "" s
            let isVS (ec : IEnumerable<ICell>) : string = Seq.fold (fun a  i -> a + ";" + (castO2 i (cellType i))) "" ec
            let isE (ee : IEnumerable<IEnumerable>) : string = Seq.fold (fun a  i -> a + ";" + EnumerableValue i incValue t) "" ee
            let isO (ee : IEnumerable<Object>) : string = Seq.fold (fun a  i -> a + ";" + (castO i)) "" ee
            let toAStr (s : string) = sprintf "[%s]" (s.Substring(1))
            match e with
                | :? IEnumerable<DateTime> as d         -> isd d  |> toAStr
                | :? IEnumerable<string> as s           -> iss s  |> toAStr 
                | :? IEnumerable<ICell> as c            -> isVS c |> toAStr
                | :? IEnumerable<IEnumerable> as ee     -> isE ee |> toAStr
                | _                                     -> isO (SeqEnum e) |> toAStr

        (* 
            Take a value and convert to the source equivilent
        *)
        and  ValueSource (c : ICell) (isOptional : bool) (t : Type) (incValue : bool) : string =
            let formVal (c : ICell) =
                match c with
                | :? Base.IVector as v          -> sprintf "CoVector %s" (EnumerableValue (v  :?> IEnumerable) incValue t)
                | :? Base.IMatrix as m          -> sprintf "CoMatrix %s" (EnumerableValue (m  :?> IEnumerable) incValue t) 
                | :? Base.ICube as cu           -> sprintf "CoCube %s"   (EnumerableValue (cu :?> IEnumerable) incValue t)
                | :? IEnumerable as e           -> EnumerableValue e incValue t
                | :? ICellEmpty                 -> "None"
                | :? ICell<DateTime> as d   -> sprintf "DateTime(%d, %d, %d)" d.Value.Year d.Value.Month d.Value.Day
                | :? ICell<string> as s     -> sprintf "\"%s\"" s.Value
                | _ when t.IsEnum           -> String.Format ("{0}.{1}", t.FullName, c.BoxValue)
                | _                         -> sprintf "%A" c.BoxValue
            let SSome s = if s = "None" then s else sprintf "Some %s" s
            let Value = if incValue then ".Value" else ""
            match c.Mnmonic with
                   | null when isOptional   -> SSome (formVal c)
                   | ""   when isOptional   -> SSome (formVal c)
                   | _    when isOptional   -> sprintf "Some _%s%s" (CleanMnmonic c.Mnmonic) Value 
                   | ""                     -> formVal c
                   | null                   -> formVal c
                   | _                      -> sprintf "_%s%s " (CleanMnmonic c.Mnmonic) Value
        (* 
            Take a Cell value as place in a tuple of name, and source value.
            used in <> to build a function call with inline casting 
        *)
        let ValueTuple (c : ICoCell<'t>, isOptional : bool) : (Type * string) =
            if c = null then 
                (typeof<'t>, "None")    
            else
                let t = cellType c
                t, (ValueSource c isOptional t true)

        let Value (c : ICell) (isOptional : bool) = 
            ValueSource c isOptional (cellType c) true

        // get the source for an enumeration
        let EnumerationSource (e : IEnumerable) =
            let t = e.GetType()
            let rec contentType (t : Type) = 
                if t.IsGenericType then
                    let t2 = t.GetGenericArguments().[0]
                    if typeof<ICell>.IsAssignableFrom (t2) then
                        t2
                    else
                        contentType t.BaseType
                else
                    contentType t.BaseType
            if e :? Base.IVector || e :? Base.IMatrix || e :? Base.ICube then
                EnumerableValue e false (contentType t)
            else
                EnumerableValue e false t

        let ParameterSource (t : Type, name : string, values : (Type * string)[]) : string =
            let trimName = name.Trim ()
            let withParameters = 
                // get all the prototypes for the function from the target
                let from = 
                    if trimName = ".ctor" then
                        let meths = Array.filter (fun (mi : ConstructorInfo) -> mi.Name = trimName) (t.GetConstructors ())
                        let param (meth : ConstructorInfo) = 
                            let p = meth.GetParameters ()   
                            Array.map (fun (pin : Reflection.ParameterInfo) -> pin.ParameterType) p
                        Array.map param meths
                        |> Array.filter (fun (p : Type[]) -> p.Length = values.Length)
                    else
                        let meths = Array.filter (fun (mi : MethodInfo) -> mi.Name = trimName) (t.GetMethods ())
                        let param (meth : MethodInfo) = 
                            let p = meth.GetParameters ()   
                            Array.map (fun (pin : Reflection.ParameterInfo) -> pin.ParameterType) p
                        Array.map param meths
                        |> Array.filter (fun (p : Type[]) -> p.Length = values.Length)
                // join the type array from the target to the (type*string) array of the source
                let join =
                    Array.map (fun x -> (Array.map2 (fun a b -> a, b) x values)) from
                // filter the rows where all the column types match
                let filter = 
                    let filterRow (row : (Type * (Type * string))[]) : bool = 
                        // subtype or same type predicate
                        let predicate (a : Type, (b : Type , c : string)) : bool =
                            let optionPredicate (a : Type)  (b : Type) = 
                                let t = a.GetGenericArguments().[0]
                                b = t || t.IsAssignableFrom (b)
                            a = b || a.IsAssignableFrom (b) || (a.IsGenericType && (optionPredicate a b)) 
                        // true if all columns true
                        Array.fold (fun x y -> x && (predicate y)) true row
                    // filter rows.. can only be one (compile would fail otherwise)
                    (Array.filter (fun row -> filterRow row) join).[0]
                let format (a : Type, (b : Type , c : string)) =
                    if a = b || c = "None" || b.IsEnum then
                        c                                       // plain
                    elif c.StartsWith("Some ") && a.IsGenericType then
                        let pt = a.GetGenericArguments().[0]
                        if pt.IsValueType then
                            sprintf "Some (%s)" (c.Substring(5)) 
                        else
                            sprintf "Some (%s :> %s)" (c.Substring(5)) (sourceType (pt))
                    else 
                        sprintf "(%s :> %s)" c (sourceType a)         // with cast
                (Array.fold (fun a b -> a + ", " + format b) "" filter).Substring(1)
            match values.Length with
            | 0 -> ""
            | _ -> withParameters
       
        let IsModel (c :ICell) : bool = 
            match c with
            | :? IModel -> true
            | _         -> false
                        
        let IsAlias (c : ICell) : bool =
            match c with
            | :? ICellAlias -> true
            | _             -> false
        
        let TranslateModel (m : IModel) : string =
            let model2SortedTiers (m :IModel) =
                let rec cellTier (c : ICell) =
                    let dep = c.References 
                    match dep.Length with
                    | 0 -> 0
                    | n -> Array.max (Array.map (fun c-> (cellTier c) + 1) dep)
                let sq = Seq.map (fun (c : KeyValuePair<string,ICell>) -> {tier = cellTier c.Value; cell = c.Value}) m
                Seq.sortBy  (fun (p : IndexEntry) -> p.tier) sq 
                |> Seq.toList
                |> List.filter (fun p -> not (p.cell :? ICellEmpty || p.cell.Mnmonic.StartsWith ("!@"))) 
                |> List.map (fun i -> i.cell)
            let sm = model2SortedTiers m

            let body (m : IModel) = 
                let letDef (c : ICell) = 
                    if c.Method = CellMethod.ByAssignment  then 
                        sprintf "    let mutable _%s = cell.Value %s" ( LocalMnemonic c.Mnmonic) (ValueAsText c.BoxValue)
                    elif c.Mnmonic.StartsWith ("!-") then
                        sprintf "    let _%s = CellProxy {{ return %s }}" (LocalMnemonic c.Mnmonic) (c.ToString())
                    elif IsModel c then
                        String.Format ("    let mutable _{0} = {0} (this)", (LocalMnemonic c.Mnmonic))
                    elif IsAlias c then
                        let a = c :?> ICellAlias
                        String.Format ("    let _{0} = Cell.Lookup<{1}> (this, {2})", (LocalMnemonic c.Mnmonic), a.AliasMnmonic, a.ToString())
                    elif c :? Base.ICube then
                        String.Format ("    let _{0} = cell.Cube {1}", (LocalMnemonic c.Mnmonic),c.ToString())
                    elif c :? Base.IMatrix then
                        String.Format ("    let _{0} = cell.Matrix {1}", (LocalMnemonic c.Mnmonic),c.ToString())
                    elif c :? Base.IVector then
                        String.Format ("    let _{0} = cell.Vector {1}", (LocalMnemonic c.Mnmonic),c.ToString())
                    else 
                        String.Format ("    let _{0} = cell {{ return {1} }}", (LocalMnemonic c.Mnmonic), c.ToString())

                let memberDef (c : ICell) = 
                    if c.Method = CellMethod.ByAssignment  then 
                        String.Format ("    member this.{0} with get () = _{0} and set (v) = _{0} <- v", (LocalMnemonic c.Mnmonic))
                    elif IsModel c then
                        String.Format ("    [<DataMember (Name = \"{0}\")>] member this.{0} = _{0}", (LocalMnemonic c.Mnmonic))
                    elif IsAlias c then
                        String.Format ("    // Alias {0} is not public", (LocalMnemonic c.Mnmonic))
                    else
                        String.Format ("    member this.{0} = _{0}", (LocalMnemonic c.Mnmonic))

                let serialDef (c : ICell) =
                    if c.Method = CellMethod.ByAssignment then
                        String.Format ("    [<DataMember (Name = \"{0}\")>] member this.{0} with get () = CellHelper.ToChoice (_{0}) and  set (v) = _{0} <- CellHelper.ToCell (v)", (LocalMnemonic c.Mnmonic))
                    elif IsAlias c then
                        String.Format ("    // Alias {0} is not serialisable", (LocalMnemonic c.Mnmonic))
                    else
                        String.Format ("    [<DataMember (Name = \"{0}\")>] member this.{0} with get () = CellHelper.ToChoice (_{0}) and set (v) = ()", (LocalMnemonic c.Mnmonic))

                let lets    = ["    // cell definitions"] @ (List.map letDef sm)
                let members = ["\n    do this.Link ()\n\n    // access properties"] @ (List.map memberDef sm)
                let serials = ["\n    // serialisation"] @ (List.map serialDef sm)
                let lines   = lets @ members @ serials
                List.fold (fun a s -> a + "\n" + s) "" lines
            let namespac = "Cephei.Models"
            let name = CleanMnmonic m.Mnmonic 
            let cells = 
                let f (c : ICell) = 
                    (LocalMnemonic c.Mnmonic, c.Method = CellMethod.ByAssignment)
                Seq.map f sm 
                |> Seq.filter (fun (c, b) -> b) 
                |> Seq.map (fun (c, b) -> c)
                |> Seq.toArray 

            let toStringSrc =
                if cells.Length = 0 then
                    ""
                else 
                    (Array.fold (fun s c -> s + ",(Generator.ValueSource " + c + ")") "" cells).Substring(1)
            let param = 
                let r = 
                    Array.fold (fun s c -> s + "," + c ) "" cells
                if r = "" then ",mnmonic" else r
            let constr = 
                let r = 
                    Array.fold (fun s c -> s + "            this." + c + " <- " + c + "\n") "" cells
                if r = "" then "            this.Mnmonic <- mnmonic\n" else r
            let xconstr = 
                Array.fold (fun s c -> s + "            this." + c + " <- t.WithBaseType (this." + c + ", CellHelper.CellObject (m, q.Dequeue())) \n") "" cells

            let xlparam = 
                let tabs = "        "
                let m = tabs + "( [<ExcelArgument (\"Mnmonic\")>] Mnmonic : Object \n"
                Array.fold (fun s c -> s + tabs + ", [<ExcelArgument (\"" + c + "\")>] " + c + " : Object \n") m cells
            let arrayitems = 
                Array.fold (fun s c -> s + "; " + c ) "Mnmonic" cells

            String.Format
                ("

[<DataContract(Name=\"{1}\")>]
type {1} (model : IModel) as this =
    inherit Cephei.Kernel.Model (model)
{2}

    // transformation
    override this.ToString () =
        {0}.{1} ({3})

    // constructors
    new (m{4}) as this =
        {1} (m) then
            use t = new Transaction (this)
{5}

    new () =
        {1} (null) 
    
    new (oar : Object[], mnmonic : string, m : IModel) as this = 
        {1} (m) then 
            use t = new Transaction (this)
            let q = System.Collections.Generic.Queue (oar)
            this.Mnmonic <- mnmonic
{6}

#if EXCEL
    [<ExcelFunction (\"_{1}\")>] 
    static member _{1} 
{7}
        ) = 
        let _pam = (typeof<{1}>, [|{8}|])

        CepheiModel.Instance.Subscribe _pam
 
#endif
                "
                , namespac     // 0
                , name         // 1
                , (body m)     // 2
                , toStringSrc  // 3
                , param        // 4
                , constr       // 5
                , xconstr      // 6
                , xlparam      // 7
                , arrayitems   // 8
                )

        let Translate (m : IModel) : string =

            let rec TranslateTree (m : IModel) : string =
            
                let childModels = 
                    Seq.filter (fun (c : KeyValuePair<string, ICell>) -> IsModel c.Value) m
                    |> Seq.map (fun p -> p.Value :?> IModel) 

                let childCode =
                    Seq.fold (fun s p -> s + (TranslateTree p)) "" childModels

                let thisCode = TranslateModel m

                childCode + thisCode

            let typecode = TranslateTree m
            
            String.Format
                ("
//////////////////////////////////////////////////////////////////////
// This type was generated using Cephei.XL
//////////////////////////////////////////////////////////////////////
namespace Cephei.Models
open Cephei.Core
open Cephei.Core.Generic
open Cephei.Kernel
open System.Runtime.Serialization
open System
open Cephei.Fun
open Cephei.Cell
#if EXCEL
open ExcelDna.Integration
#endif 
{0}
                "
                , typecode 
                )
